home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue50 / IPC / Anonymous Pipes / Delphi / ParentMainFormUnit.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1999-08-28  |  3.6 KB  |  125 lines
  1. unit ParentMainFormUnit;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   Menus, StdCtrls, ExtCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Memo1: TMemo;
  12.     procedure FormCreate(Sender: TObject);
  13.     procedure FormDestroy(Sender: TObject);
  14.   private
  15.     PipeRead: THandle;
  16.   end;
  17.  
  18. {$ifdef Ver90}
  19.   //This exception class did not exist in Delphi 2
  20.   EWin32Error = class(Exception);
  21.  
  22. const
  23.   //Constant not defined in Delphi 2
  24.   Duplicate_Same_Access = 2;
  25. {$endif}
  26.  
  27. var
  28.   Form1: TForm1;
  29.  
  30. implementation
  31.  
  32. uses
  33.   ParentAnonymousPipeUnit;
  34.  
  35. {$R *.DFM}
  36.  
  37. {$ifdef Ver90}
  38. //This function class did not exist in Delphi 2
  39. function Win32Check(RetVal: Bool): Bool;
  40. var
  41.   LastError: DWord;
  42. begin
  43.   Result := RetVal;
  44.   if not RetVal then
  45.   begin
  46.     LastError := GetLastError;
  47.     if LastError <> Error_Success then
  48.       raise EWin32Error.CreateFmt( 'Win32 Error.  Code: %d.'#10'%s',
  49.         [LastError, SysErrorMessage(LastError)])
  50.     else
  51.       raise EWin32Error.Create('A Win32 API function failed')
  52.   end;
  53. end;
  54. {$endif}
  55.  
  56. function LaunchChildApp: THandle;
  57. const
  58.   ChildApp = 'ChildAnonymousPipe.Exe';
  59. var
  60.   SI: TStartupInfo;
  61.   PI: TProcessInformation;
  62. begin
  63.   GetStartupInfo(SI);
  64.   if not CreateProcess(nil, ChildApp, nil, nil,
  65.      //Make sure child inherits our inheritable handles
  66.      //as it will need to refer to them to use the pipes
  67.      True,
  68.      0, nil, nil, SI, PI) then
  69.     raise EWin32Error.Create('Unable to launch ' + ChildApp);
  70.   Result := PI.HProcess
  71. end;
  72.  
  73. {This will create an anonymous pipe and get a read and write handle
  74. back. The intention is for a child app to write to the pipe and for
  75. this parent app to read from the pipe.
  76. The security attributes will be specified to ensure that
  77. child processes can inherit these handles (i.e use their values)
  78. To communicate the write pipe handle value to the child app
  79. the STDOUT handle of this process will be replaced with the pipe
  80. handle. The child process will get a copy of this process's
  81. standard handles and so will inherit it.
  82. To ensure there is only one write handle and one read handle
  83. (for solid error trapping to work) this process must close its write
  84. handle after launching the child and before reading from the pipe.
  85. Also, to ensure the child cannot use the read pipe handle,we
  86. will duplicate the given handle and make it non-inheritable.}
  87. procedure TForm1.FormCreate(Sender: TObject);
  88. var
  89.   Security: TSecurityAttributes;
  90.   ThisProcess, PipeReadTmp, PipeWrite: THandle;
  91. const
  92.   PipeBufferSize = 0; //default size
  93. begin
  94.   with Security do
  95.   begin
  96.     nLength := SizeOf(Security);
  97.     bInheritHandle := True; //create inheritable handles
  98.     lpSecurityDescriptor := nil;
  99.   end;
  100.   Win32Check(CreatePipe(PipeRead, PipeWrite, @Security, PipeBufferSize));
  101.   //Turn STDOUT into the write pipe handle
  102.   Win32Check(SetStdHandle(Std_Output_Handle, PipeWrite));
  103.   //Ensure pipe read handle is not inheritable
  104.   ThisProcess := GetCurrentProcess();
  105.   Win32Check(DuplicateHandle(ThisProcess, PipeRead, ThisProcess,
  106.     @PipeReadTmp, 0, False, Duplicate_Same_Access));
  107.   FileClose(PipeRead);
  108.   PipeRead := PipeReadTmp;
  109.   //This launches the child process and waits for it to
  110.   //settle down before moving on to the next statement
  111.   WaitForInputIdle(LaunchChildApp, Infinite);
  112.   //Ensure only the child has an open write pipe handle
  113.   FileClose(PipeWrite);
  114.   //Start reader thread off
  115.   with TTestAnonymousPipe.Create(PipeRead) do
  116.     FreeOnTerminate := True
  117. end;
  118.  
  119. procedure TForm1.FormDestroy(Sender: TObject);
  120. begin
  121.   FileClose(PipeRead);
  122. end;
  123.  
  124. end.
  125.